home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / gsdb21.arc / GS_DBTBL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-04  |  8KB  |  328 lines
  1. UNIT GS_DBTbl;
  2.  
  3. INTERFACE
  4.  
  5. USES
  6.    Crt,
  7.    Dos,
  8.    GS_Error,
  9.    GS_KeyI,
  10.    GS_dBase,
  11.    GS_Wind,
  12.    GS_Pick,
  13.    GS_Strng,
  14.    GS_DBFld;
  15.  
  16.  
  17. type
  18.  
  19.  
  20.    dBTabl_Arry_Fld = array [0..MaxInt] of byte;
  21.    dBTabl_Pick_Obj = Object
  22.                       dbas     : ^GS_dBase_DB;      {Object to refer to}
  23.                       Pick_Win : GS_Wind_Objt;      {Window object for menu}
  24.                       Tabl     : ^dBTabl_Arry_Fld;  {Menu table on the heap}
  25.                       Sz_Tab   : longint;           {Size of table}
  26.                       siz      : integer;           {Size of a table entry}
  27.                       recs     : longint;           {Number records in table}
  28.                       Sel_Item : longint;           {Last entry number selected}
  29.                       Scn_Key  : string;            {Holds select key formula}
  30.                       AddRecOk : boolean;           {True allows appending}
  31.                       AddRec   : boolean;           {True if append selected}
  32.  
  33.                       procedure Append_dbTabl(tf : boolean);
  34.                       procedure Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
  35.                                      x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
  36.                       procedure Reset_dBTabl;
  37.                       procedure Build_dBTabl(zfld : string);
  38.                       function  Choose_dBTabl : boolean;
  39.                       function  Pick_dBTabl(zfld : string) : boolean;
  40.                       function  Find_dBTabl(pcnd : string) : boolean;
  41.                       function  FindNext_dBTabl(pcnd : string) : boolean;
  42.                       function  Scan_dBTabl(pfld, pcnd, zfld : string)
  43.                                                              : boolean;
  44.                    end;
  45.  
  46.  
  47. implementation
  48.  
  49.  
  50. var
  51.    File_Win     :  GS_Wind_Objt;
  52.    ap           :  string[10];
  53.  
  54.  
  55. procedure dBTabl_Pick_Obj.Append_dBTabl(tf : boolean);
  56. begin
  57.    AddRecOK := tf;
  58.    AddRec := false;
  59.    Reset_dBTabl;
  60. end;
  61.  
  62.  
  63.  
  64. procedure dBTabl_Pick_Obj.Init_dBTabl(var Fil : GS_dBase_DB; stg : string;
  65.                                       x1,y1,x2,y2,tx,bg,fg,itx,ibg : integer);
  66. begin
  67.    ap := '- APPEND -';
  68.    dBas := @Fil;
  69.    Tabl := nil;
  70.    Pick_Win.InitWin(x1,y1,x2,y2,tx,bg,tx,itx,ibg,true,stg,true);
  71.    Scn_Key := '^^^^';
  72.    Sel_Item := 1;
  73.    AddRecOK := false;
  74.    AddRec := false;
  75. end;
  76.  
  77. procedure dBTabl_Pick_Obj.Reset_dBTabl;
  78. begin
  79.    if Tabl <> nil then FreeMem(Tabl,Sz_Tab);
  80.    Tabl := nil;
  81.    Scn_Key := '^^^^';
  82.    Sel_Item := 1;
  83. end;
  84.  
  85. procedure dBTabl_Pick_Obj.Build_dBTabl(zfld : string);
  86. var
  87.    l : longint;
  88.    t : string[127];
  89.    ia : boolean;
  90. begin
  91.    Reset_dBTabl;
  92.    zfld := AllCaps(zfld);
  93.    Scn_Key := zfld;
  94.    with dBas^ do
  95.    begin
  96.       ia := dbfNdxActv;
  97.       dbfNdxActv := false;         {Temporarily turn off any index}
  98.       GetRec(Top_Record);
  99.       t := Formula(zfld);
  100.       l := 0;
  101.       recs := dBas^.NumRecs;
  102.       if AddRecOK then inc(recs);
  103.       siz := length(t) + 5;
  104.       Sz_Tab := recs * siz;
  105.       GetMem(Tabl,Sz_Tab);
  106.       while (not File_EOF) do
  107.       begin
  108.          t := Formula(zfld);
  109.          move(t,Tabl^[l*siz],siz-4);
  110.          move(RecNumber,Tabl^[(l*siz)+siz-4],4);
  111.          inc(l);
  112.          GetRec(Next_Record);
  113.       end;
  114.       dbfNdxActv := ia;
  115.       GetRec(Top_Record);          {Puts DBF and NDX back in sync}
  116.       recs := l;
  117.       GS_Pick_Item_Sort(Tabl^,siz,recs);
  118.    end;
  119. end;
  120.  
  121.  
  122. function dBTabl_Pick_Obj.Choose_dBTabl : boolean;
  123. var
  124.    i,
  125.    l : longint;
  126.    c1: char;
  127.    v : integer;
  128. begin
  129.    AddRec := false;
  130.    if recs > 0 then
  131.       i := GS_Pick_Row_Item(Tabl^,siz,recs, Sel_Item)
  132.    else
  133.    begin
  134.       gotoxy((((lo(WindMax)-lo(WindMin))-4) div 2)+1,
  135.              ((hi(WindMax)-hi(WindMin)) div 2)+1);
  136.       write('Empty');
  137.       repeat
  138.          c1 := GS_KeyI_GetKey;
  139.       until c1 in [#13,#27];
  140.       i := 0;
  141.    end;
  142.    if i > 0 then
  143.    begin
  144.        Choose_dBTabl := true;
  145.        if (AddREcOK) and (i = recs) then
  146.           AddRec := true
  147.        else
  148.        begin
  149.           move(Tabl^[((i-1)*siz)+siz-4],l,4);
  150.           dBas^.GetRec(l);
  151.        end;
  152.        Sel_Item := i;
  153.    end else Choose_dBTabl := false;
  154. end;
  155.  
  156. function dBTabl_Pick_Obj.Pick_dBTabl(zfld : string) : boolean;
  157. var
  158.    t  : string[127];
  159.    v  : integer;
  160.    ta : byte;
  161. begin
  162.    Pick_Win.SetWin;
  163.    AddRec := false;
  164.    zfld := AllCaps(zfld);
  165.    if Scn_Key <> zfld then Reset_dBTabl;
  166.    Scn_Key := zfld;
  167.    if Tabl = nil then
  168.    begin
  169.       gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
  170.               ((hi(WindMax)-hi(WindMin)) div 2)+1);
  171.       ta := TextAttr;
  172.       TextAttr := TextAttr + 128;
  173.       write('Working');
  174.       TextAttr := ta;
  175.       Build_dBTabl(zfld);
  176.       if AddRecOK then
  177.       begin
  178.          inc(recs);
  179.          v := siz-5;
  180.          FillChar(t[1],v,' ');
  181.          t[0] := chr(v);
  182.          Insert(ap,t,succ((v - 10) div 2));
  183.          System.Delete(t,v+1,10);
  184.          move(t,Tabl^[(recs-1)*siz],siz-4);
  185.       end;
  186.    end;
  187.    ClrScr;
  188.    Pick_dBTabl := Choose_dBTabl;
  189.    Pick_Win.RelWin;
  190. end;
  191.  
  192. function dBTabl_Pick_Obj.Find_dBTabl(pcnd : string) : boolean;
  193. var
  194.    i,
  195.    l : longint;
  196.    m,
  197.    s : string;
  198.    mtch : boolean;
  199. begin
  200.    mtch := false;
  201.    m := AllCaps(pcnd);
  202.    if recs > 0 then
  203.    begin
  204.       i := 0;
  205.       repeat
  206.          move(Tabl^[i*siz],s,siz-4);
  207.          s[0] := m[0];
  208.          if (AllCaps(s) = m) then mtch := true;
  209.          inc(i);
  210.       until (i = recs) or (mtch);
  211.       if not mtch then i := 0;
  212.    end
  213.    else
  214.    begin
  215.       i := 0;
  216.    end;
  217.    if i > 0 then
  218.    begin
  219.        Find_dBTabl := true;
  220.        move(Tabl^[((i-1)*siz)+siz-4],l,4);
  221.        dBas^.GetRec(l);
  222.        Sel_Item := i;
  223.    end else Find_dBTabl := false;
  224. end;
  225.  
  226. function dBTabl_Pick_Obj.FindNext_dBTabl(pcnd : string) : boolean;
  227. var
  228.    i,
  229.    l : longint;
  230.    m,
  231.    s : string;
  232. begin
  233.    m := AllCaps(pcnd);
  234.    if (recs > 0) and (Sel_Item < recs) then
  235.    begin
  236.       i := Sel_Item;
  237.       move(Tabl^[i*siz],s,siz-4);
  238.       s[0] := m[0];
  239.       inc(i);
  240.       if AllCaps(s) <> m then i := 0;
  241.    end
  242.    else
  243.    begin
  244.       i := 0;
  245.    end;
  246.    if i > 0 then
  247.    begin
  248.        FindNext_dBTabl := true;
  249.        move(Tabl^[((i-1)*siz)+siz-4],l,4);
  250.        dBas^.GetRec(l);
  251.        Sel_Item := i;
  252.    end else FindNext_dBTabl := false;
  253. end;
  254.  
  255. function dBTabl_Pick_Obj.Scan_dBTabl(pfld, pcnd, zfld : string) : boolean;
  256. var
  257.    m,
  258.    s  : string;
  259.    t  : string[127];
  260.    v  : integer;
  261.    ta : byte;
  262.    ia : boolean;
  263.    l  : longint;
  264. begin
  265.    Pick_Win.SetWin;
  266.    AddRec := false;
  267.    zfld := AllCaps(zfld);
  268.    pfld := AllCaps(pfld);
  269.    Reset_dBTabl;
  270.    Scn_Key := zfld;
  271.    gotoxy((((lo(WindMax)-lo(WindMin))-6) div 2)+1,
  272.            ((hi(WindMax)-hi(WindMin)) div 2)+1);
  273.    ta := TextAttr;
  274.    TextAttr := TextAttr + 128;
  275.    write('Working');
  276.    TextAttr := ta;
  277.    with dBas^ do
  278.    begin
  279.       ia := dbfNdxActv;
  280.       dbfNdxActv := false;         {Temporarily turn off any index}
  281.       GetRec(Top_Record);
  282.       m := Formula(pfld);
  283.       if m[0] < pcnd[0] then pcnd[0] := m[0];
  284.       m := AllCaps(pcnd);
  285.       t := Formula(zfld);
  286.       l := 0;
  287.       recs := dBas^.NumRecs;
  288.       if AddRecOK then inc(recs);
  289.       siz := length(t) + 5;
  290.       Sz_Tab := recs * siz;
  291.       GetMem(Tabl,Sz_Tab);
  292.       while (not File_EOF) do
  293.       begin
  294.          s := Formula(pfld);
  295.          s[0] := m[0];
  296.          if AllCaps(s) = m then
  297.          begin
  298.             t := Formula(zfld);
  299.             move(t,Tabl^[l*siz],siz-4);
  300.             move(RecNumber,Tabl^[(l*siz)+siz-4],4);
  301.             inc(l)
  302.          end;   ;
  303.          GetRec(Next_Record);
  304.       end;
  305.       dbfNdxActv := ia;
  306.       GetRec(Top_Record);          {Puts DBF and NDX back in sync}
  307.       recs := l;
  308.       GS_Pick_Item_Sort(Tabl^,siz,recs);
  309.    end;
  310.    if AddRecOK then
  311.    begin
  312.       inc(recs);
  313.       v := siz-5;
  314.       FillChar(t[1],v,' ');
  315.       t[0] := chr(v);
  316.       Insert(ap,t,succ((v - 10) div 2));
  317.       System.Delete(t,v+1,10);
  318.       move(t,Tabl^[(recs-1)*siz],siz-4);
  319.    end;
  320.    ClrScr;
  321.    Scan_dBTabl := Choose_dBTabl;
  322.    Pick_Win.RelWin;
  323. end;
  324.  
  325.  
  326.  
  327. end.
  328.